home *** CD-ROM | disk | FTP | other *** search
/ MacWorld 1999 July / Macworld (1999-07).dmg / Shareware World / Info / For Developers / Mops 3.4.sea / Mops source / PPC source / bug fix.doc < prev    next >
Text File  |  1998-12-09  |  11KB  |  409 lines
  1. \ Initialization of system objects.
  2.  
  3. syscall AEInstallEventHandler
  4. syscall InstallExceptionHandler
  5.  
  6.  
  7. : -MODELESS    \ Sets normal event handling - no modeless dialogs
  8.     xts{    null-evt    mouse-evt    null-evt    key-evt
  9.             null-evt    key-evt        upd-evt        disk-evt
  10.             actv-evt    null-evt    null-evt    null-evt
  11.             null-evt    null-evt    null-evt    OS-evt
  12.             null-evt    null-evt    null-evt    null-evt
  13.             null-evt    null-evt    null-evt    HL-evt   }
  14.     put: fEvent  ;
  15.  
  16. ' null-evt fill: fevent        \ using -modeless during compilation causes
  17.                             \ strange scrolling effects in fWind
  18.  
  19.  
  20. \        ==================== :PPC_PROC =====================
  21.  
  22. :ppc_code :entry_code
  23.     rOSSP    -256    rOSSP    stwu,
  24.     RTOC    20        rOSSP    stw,
  25.     r13        100        rOSSP    stw,
  26.     r14        104        rOSSP    stw,
  27.     r15        108        rOSSP    stw,
  28.     r16        112        rOSSP    stw,
  29.     r17        116        rOSSP    stw,
  30.     r18        120        rOSSP    stw,
  31.     r19        124        rOSSP    stw,
  32.  
  33.     r13        104        rTOC    lwz,
  34.     r14        108        rTOC    lwz,
  35. \    r15        112        rTOC    lwz,
  36. \    r16        116        rTOC    lwz,
  37.     r17        120        rTOC    lwz,
  38.     r17        r17        -1024    addi,
  39.     r18        124        rTOC    lwz,
  40.     r18        r18        -4096    addi,
  41.     r19        128        rTOC    lwz,
  42. ;ppc_code
  43.  
  44. :ppc_code ;entry_code
  45.     r13        100        rOSSP    lwz,
  46.     r14        104        rOSSP    lwz,
  47.     r15        108        rOSSP    lwz,
  48.     r16        112        rOSSP    lwz,
  49.     r17        116        rOSSP    lwz,
  50.     r18        120        rOSSP    lwz,
  51.     r19        124        rOSSP    lwz,
  52.     rOSSP    0        rOSSP    lwz,        \ take down frame
  53.                             blr,
  54. ;ppc_code
  55.  
  56.  
  57. (*    :PPC_PROC begins a definition that is to be used as a callback.
  58.     Note that we make no provision to call one of these directly from
  59.     Mops code -- there's really no reason why anyone would want to.
  60.     We use a handler code of BE04, and add some extra info after 
  61.     the header and before the code starts.  This is the logical place
  62.     to put this info, although it means that we can't use "postpone :".
  63.     See the comments in the code below for the nuts and bolts.
  64.  
  65.     At ;ppc_proc time, we add code at the beginning and the end
  66.     to save the regs we're going to change, set up the Mops
  67.     regs, then restore everything at the end.  This is the same
  68.     as what we have to do with :ENTRY words (entry points for
  69.     a shared library).
  70. *)
  71.  
  72.  
  73. : :PPC_PROC  ( procInfo -- 306 )
  74.  
  75.     CDP -> const_data_start
  76.     ppc_header
  77.     $ BE040000 code,        \ handler code for :PPC_proc defns,
  78.                             \  and alignment
  79.  
  80.     align4                    \ align in data area
  81.     CDP                        \ save CDP for reloc!
  82.     0 code,                    \ in code area, space for reloc ptr
  83.     swap code,                \ and then comes the procInfo
  84.     0 code,                    \  2 bytes padding, 2 initial flag bytes
  85.     DP swap reloc!            \ store reloc pointer to data area
  86.  
  87.     12 reserve                \ in data area, leave room for:
  88.                             \    4 bytes:    pointer to routine descriptor
  89.                             \    8 bytes:    transfer vector
  90.                             \ We set these up at fix_procs below, at objinit time.
  91.  
  92.     false -> method?
  93.     false -> noname?
  94.     0 >size: control_stk  0 >size: control_flags
  95.  
  96.     false ppc_entry            \ handle ppc proc entry
  97.     false -> leaf?            \ so our parms get handled consistently
  98.     postpone hide            \ new word is hidden until defn end
  99.     1 -> gpr_rtn_cnt        \ :ppc_procs always return just one result in r3
  100.     -1 -> fpr_rtn_cnt        \ this may need revising $$$$$$$$
  101.     true -> entry?
  102.  
  103.     drop 306                \ use different security marker from colon
  104. ;        immediate
  105.  
  106.  
  107. : ;ppc_proc { \ x -- }
  108.     306 ?defn
  109.     curr-def 2- (;)
  110.     -4 ++> CDP                \ delete the blr
  111.     
  112.     ['] ;entry_code 2+  CDP  36 aligned_move
  113.     36 ++> CDP
  114.  
  115.     ['] :entry_code 2+
  116.     curr-def
  117.     64  aligned_move
  118.  
  119. ;        immediate
  120.  
  121.  
  122.  
  123. konst uppAEEventHandlerProcInfo
  124. :ppc_proc openAppHandler  { x y z -- noErr }  0  ;ppc_proc
  125.  
  126. konst uppAEEventHandlerProcInfo
  127. :ppc_proc openDocHandler  { x y z -- noErr }  0  ;ppc_proc
  128.  
  129. konst uppAEEventHandlerProcInfo
  130. :ppc_proc printDocHandler  { x y z -- noErr }  0  ;ppc_proc
  131.  
  132. konst uppAEEventHandlerProcInfo
  133. :ppc_proc quitAppHandler  { x y z -- noErr }  0  ;ppc_proc
  134.  
  135.  
  136. : (fix_proc)  { xt dummy \ addr procInfo ^flags -- }
  137.     xt 2- w@ $ BE04 <>  ?EXIT    \ out if this isn't a :PPC_proc
  138.  
  139.     xt 6 + @  -> procInfo        \ pick up the procInfo for passing to
  140.                                 \  NewRoutineDescriptor
  141.                                 
  142.     xt 2+ @abs  -> addr            \ now we look at data area info
  143.  
  144.     xt 12 + -> ^flags
  145.     ^flags c@ $ 10 and            \ fp flags?
  146.     IF  6  ELSE  2  THEN
  147.     ^flags +                    \ defn code starts here
  148.  
  149.     addr 4+ !                    \ set up the transition vector
  150.     RTOC    addr 8 + !
  151.  
  152. \ now we call NewRoutineDescriptor - this returns a pointer to a
  153. \  new descriptor - this pointer is a Universal ProcPtr (UPP).
  154. \ We store this at addr.
  155.  
  156.     addr 4+        \ tv addr
  157.     procInfo  konst kPowerPCISA  NewRoutineDescriptor
  158.     addr !
  159. ;
  160.  
  161.  
  162. : fix_procs
  163.     ['] (fix_proc)  0  trav  ;
  164.  
  165. : install_AE_handler  ( aevt-type event-type xt -- )
  166. \    2+ @abs @                \ get the UPP from the :proc info
  167.     0                        \ handlerRefCon = 0
  168.     0                        \ isSysHandler = false
  169.     AEInstallEventHandler  ?startUpError
  170. ;
  171.  
  172.  
  173. : install_reqd_appleEvents
  174.     'type aevt  'type oapp
  175.     ['] openAppHandler            \ AE handler addr
  176.     install_AE_handler
  177.     
  178.     'type aevt  'type odoc
  179.     ['] openDocHandler
  180.     install_AE_handler
  181.     
  182.     'type aevt  'type pdoc
  183.     [']    PrintDocHandler
  184.     install_AE_handler
  185.  
  186.     'type aevt  'type quit
  187.     ['] QuitAppHandler
  188.     install_AE_handler
  189. ;
  190.  
  191.  
  192. \        ===================  EXCEPTIONS ===================
  193.  
  194. (* 
  195. We have to resort to assembly for our exception handler, since
  196. when it's called none or our registers are set up!  We recover
  197. them from the register save area in the exception info (see the
  198. description of this in IM).  Each reg is saved in 8 bytes, so
  199. everything will be compatible on future 64-bit PPCs.  (When
  200. that happens, we'll have to revise this code.  I think it will
  201. be a while yet.)
  202.  
  203. On entry, r3 -> the exception info.
  204.  
  205. Note from Apple:
  206.     An ExceptionHandler is NOT a UniversalProcPtr.
  207.     It must be a native function pointer with NO routine descriptor.
  208. *)
  209.  
  210. variable    temp
  211.  
  212. :ppc_code myExceptionHandler
  213.     r5            0    r3        lwz,        \ r5 = exception type - will be TOS
  214.     r12            8    r3        lwz,        \ r12 -> register info
  215.     r12            r12    4        addi,        \ look at lo 32 bits of regs
  216.     r1            8    r12        lwz,        \ restore r1
  217.     r2            16    r12        lwz,        \ r2
  218.     r3         3 8 *    r12        lwz,        \ we'll get r3 and r4 since that
  219.     r4         4 8 *    r12        lwz,        \  might help in the error dump
  220.     r13        13 8 *    r12        lwz,
  221.     r14        14 8 *    r12        lwz,
  222.     r15        15 8 *    r12        lwz,
  223.     r16        16 8 *    r12        lwz,
  224.     r17        17 8 *    r12        lwz,
  225.     r18        18 8 *    r12        lwz,
  226.     r19        19 8 *    r12        lwz,
  227.     r20        20 8 *    r12        lwz,
  228.     r21        21 8 *    r12        lwz,
  229.  
  230. (*    r22        22 8 *    r12        lwz,        \ not much point in bothering
  231.     r23        23 8 *    r12        lwz,        \  with these
  232.     r24        24 8 *    r12        lwz,
  233.     r25        25 8 *    r12        lwz,
  234.     r26        26 8 *    r12        lwz,
  235.     r27        27 8 *    r12        lwz,
  236.     r28        28 8 *    r12        lwz,
  237.     r29        29 8 *    r12        lwz,
  238.     r30        30 8 *    r12        lwz,
  239.     r31        31 8 *    r12        lwz,
  240. *)
  241.     r0        ' (excep) 2+    dicaddr,    \ we set (excep) up with 3 parms
  242.     r0                        mtctr,
  243.                             bctr,
  244. ;ppc_code
  245.  
  246. : install_my_exception_handler
  247.     ['] myExceptionHandler 2+ temp !
  248.     temp  InstallExceptionHandler  drop
  249. ;
  250.  
  251. : fix_segments  { \ ^ST len segStart #chopped curr_code curr_data -- }
  252.  
  253.     instld?  0EXIT
  254.  
  255.     segTable -> ^ST
  256.     code_start -> curr_code
  257.     code_start 56 + @ -> #chopped
  258.     curr_code #chopped - segTable 4+ !    \ seg 8 base addr (main dic code)
  259.     code_start 4+ @  dup ++> curr_code
  260.     #chopped +            segTable !        \ seg 8 length
  261.     
  262.     data_start -> curr_data
  263.     code_start 60 + @ -> #chopped
  264.     curr_data #chopped - segTable 12 + !    \ seg 9 base addr (main dic data)
  265.     code_start 8 + @  dup ++> curr_data
  266.     #chopped +            segTable 8 + !    \ seg 9 length
  267.  
  268.     max_segs 2
  269.     DO    i  8 *  segTable +  -> ^ST
  270.         ^ST c@ 1 and
  271.         IF            \ this one is installed
  272.             ^ST @ $ 00ffffff and #align4  -> len
  273.             i 1 and
  274.             IF        \ it's data
  275.                 curr_data  ^ST 4+ !
  276.                 len ++> curr_data
  277.             ELSE    \ it's code
  278.                 curr_code  ^ST 4+ !
  279.                 len ++> curr_code
  280.             THEN
  281.         THEN
  282.     LOOP
  283. ;
  284.  
  285. : chk_thread  { thread# \ thread_addr prev_lfa lfa -- }
  286.  
  287.     thread# dummy_len c!                \ fake a "length byte" for THREAD
  288.     dummy_len thread  -> thread_addr    \ addr of thread start in CONTEXT
  289.     
  290.     thread_addr displace  -> lfa        \ addr of first link field in thread,
  291.                                         \  in CONTEXT
  292.     lfa -> prev_lfa
  293.     BEGIN    lfa
  294.     WHILE    lfa -> prev_lfa
  295.             lfa displace -> lfa
  296.     REPEAT
  297. ;
  298.  
  299.  
  300. : chkdic
  301.     #threads  FOR  i chk_thread  NEXT
  302. ;
  303.  
  304.  
  305. \ Any special run-time initialization can be done conveniently by adding
  306. \ the appropriate words to the x-col INIT_ACTIONS.  These words will be
  307. \ executed on startup via EXTRA_INITS, right after the rest of the
  308. \ initialization stuff has been done.
  309.  
  310.     8    x-col    INIT_ACTIONS
  311.  
  312.  
  313. : EXTRA_INITS
  314.     size: init_actions  0  ?DO  i exec: init_actions  LOOP
  315. ;
  316.  
  317.  
  318. : SYSINIT        \ our final initialization word.  Called regardless ofwhether 
  319.                 \  we're in the development environment or an installed app.
  320.     init2
  321.     fix_segments
  322.     fix_procs
  323.     install_reqd_appleEvents
  324.     install_my_exception_handler
  325.     0 -> actW
  326.     resize_fWind
  327.     $ F5EF  setMask: fEvent        \ mask out key up
  328.     -modeless   key!  +curs
  329.     extra_inits                    \ do any extra initialization
  330. ;
  331.  
  332. (*
  333. PAUSE should be called at strategic intervals in all applications,
  334. unless Key is being called frequently (see note 1 below).  Pause
  335. normally calls  next: fEvent  which allows a task switch to be done
  336. under MultiFinder, and which also handles any pending events for this
  337. task, such as window updates.  Remember to disable any menus etc. that
  338. you don't want to execute in this situation!  Unexpected re-entrancy
  339. is a good way to bomb!
  340.  
  341. NOTE THE FOLLOWING POINTS:
  342.  
  343. 1.  KEY also calls  next: fEvent.  So if we're waiting on keys,
  344. we shouldn't call Pause, especially as Pause will gobble any keys
  345. typed!
  346.  
  347. 2.  next: fEvent  calls WaitNextEvent.  If we don't want to be
  348. suspended until the next event for us, we need to set SleepTicks to
  349. a suitably low number.  PAUSE by default sets SleepTicks to zero
  350. temporarily.  Change this if necessary.
  351.  
  352. 3.  If multitasking is installed, PAUSE may be redirected (but not
  353. necessarily) so that it just calls NEXT_TASK to do a task switch.
  354. This will happen if we have a foreground task calling  next: fEvent
  355. repeatedly, while we do all the real work in the background.
  356. This way we can keep executing during window drags and menu selections.
  357.  
  358. 4.  Dereferenced pointers may become invalid across a PAUSE.  Be careful.
  359. *)
  360.  
  361. : (PAUSE)
  362.     savingDic?  ?EXIT        \ If called during a dic save, mustn't process
  363.                             \  events since modules are purged
  364.     sleepticks  0 -> sleepticks
  365.     getMask: fEvent  $ FFC7 setMask: fEvent        \ all except key events
  366.     next: fEvent  \ IF  2drop  THEN    \ 30Apr94 DBH next: no longer returns stack items
  367.     setMask: fEvent   -> sleepticks  ;
  368.  
  369.  
  370. \ CL3 is the next cleanup word - it cleans up all object stuff on abort,
  371. \ as well as whatever we were doing before (see CL2 in file Files, and CL1
  372. \ in file Class).
  373.  
  374. : CL3
  375.     ( key! )  0 HiliteMenu   arrowcurs
  376.     cl2  ;
  377.  
  378.  
  379. : (SF)
  380.     alive: fWind IF  setContRect: fWind  set: fWind  select: fWind  THEN
  381.     initfont  ;
  382.  
  383.  
  384. ' sysinit    -> objinit
  385. ' (pause)    -> pause
  386. ' (sf)        -> setFwind
  387. ' cl3        -> abortvec
  388.  
  389.  
  390. :f RUN
  391.     cr ." This is the stage 3 nucleus." cr
  392.     QUIT
  393. ;f
  394.  
  395.  
  396. \ ========= Some ppc_procs we need which are used in modules =========
  397.  
  398. \ TEScroller
  399.  
  400. nilP    value    ClickedScroller
  401.  
  402.  
  403. konst uppTEClickLoopProcInfo
  404.  
  405. :ppc_proc  DRAGPROC
  406.     autoScroll: [ clickedScroller ]
  407.     1                \ We have to return a Pascal boolean TRUE!
  408. ;ppc_proc
  409.